home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / cli / mx2src.arc / PIPE.MOD < prev    next >
Text File  |  1989-01-05  |  7KB  |  231 lines
  1.  
  2. (*              Copyright 1987 fred brooks LogicTek             *)
  3. (*                                                              *)
  4. (*                                                              *)
  5. (*   First Release                      12/8/87-FGB             *)
  6. (* Correct Bad error in PipeOpen causing pipe to be closed if   *)
  7. (* this routine is called               12/14/87                *)
  8. (*                                                              *)
  9.  
  10. (*$S-,$T- *)
  11. IMPLEMENTATION MODULE PIPE [7];
  12. FROM    SYSTEM    IMPORT   BYTE,WORD,LONGWORD,ADDRESS,TSIZE,ADR;
  13. FROM    ATOMIC    IMPORT   pipetype,sysvariable,PIPE,pipeptr,buflength;
  14. FROM    SYSCALL   IMPORT   SysVar;
  15. FROM    Storage   IMPORT   ALLOCATE,DEALLOCATE;
  16. FROM    Strings   IMPORT   Assign,Compare,CompareResults;
  17. FROM    TextIO    IMPORT   WriteString,WriteLn,ReadLn;
  18. CONST             bufend = buflength-1;
  19. VAR               pipe1,pipe          :       pipeptr;
  20.                   junk                :       BYTE;
  21.                   pipespointer        :       POINTER TO pipetype;
  22.                   sysvar              :       sysvariable;
  23.                   I                   :       CARDINAL;
  24.                   found               :       BOOLEAN;
  25.                 b                :         POINTER TO ARRAY [0..1] OF BYTE;
  26.                 d                :         CARDINAL;
  27.                 b1              :         POINTER TO ARRAY [0..3] OF BYTE;
  28.              newpipeptr         :     pipeptr;
  29.  
  30. PROCEDURE       PWriteByte(p: LONGCARD; b: BYTE): BOOLEAN;
  31. BEGIN
  32.         IF NOT PipeOpen(p) THEN RETURN FALSE END;
  33.         pipe:=pipeptr(p);
  34.         IF (NOT (pipe^.cnt < buflength)) THEN RETURN FALSE END;
  35.         deposit(pipe,b);
  36.         RETURN TRUE;
  37. END     PWriteByte;
  38.  
  39. PROCEDURE       PReadByte(p: LONGCARD; VAR b: BYTE): BOOLEAN;
  40. BEGIN
  41.         IF NOT PipeOpen(p) THEN RETURN FALSE END;
  42.         pipe:=pipeptr(p);
  43.         IF (NOT (pipe^.cnt > 0)) THEN RETURN FALSE END;
  44.         b:=withdraw(pipe);
  45.         RETURN TRUE;
  46. END     PReadByte;
  47.  
  48. PROCEDURE       PWriteWord(p: LONGCARD; w: WORD): BOOLEAN;
  49. BEGIN
  50.         IF NOT PipeOpen(p) THEN RETURN FALSE END;
  51.         pipe:=pipeptr(p);
  52.         IF (NOT (pipe^.cnt < buflength-1)) THEN RETURN FALSE END;
  53.         b:=ADR(w);
  54.         FOR d:=0 TO 1 DO
  55.             deposit(pipe,b^[d]);
  56.         END;
  57.         RETURN TRUE;
  58. END     PWriteWord;
  59.  
  60. PROCEDURE       PReadWord(p: LONGCARD; VAR w: WORD): BOOLEAN;
  61. BEGIN
  62.         IF NOT PipeOpen(p) THEN RETURN FALSE END;
  63.         pipe:=pipeptr(p);
  64.         IF (NOT (pipe^.cnt > 1)) THEN RETURN FALSE END;
  65.         b:=ADR(w);
  66.         FOR d:=0 TO 1 DO
  67.             b^[d]:=withdraw(pipe);
  68.         END;
  69.         RETURN TRUE;
  70. END     PReadWord;
  71.  
  72. PROCEDURE       PWriteLongWord(p: LONGCARD; lw: LONGWORD): BOOLEAN;
  73. BEGIN
  74.         IF NOT PipeOpen(p) THEN RETURN FALSE END;
  75.         pipe:=pipeptr(p);
  76.         IF (NOT (pipe^.cnt < buflength-3)) THEN RETURN FALSE END;
  77.         b1:=ADR(lw);
  78.         FOR d:=0 TO 3 DO
  79.             deposit(pipe,b1^[d]);
  80.         END;
  81.         RETURN TRUE;
  82. END     PWriteLongWord;
  83.  
  84. PROCEDURE       PReadLongWord(p: LONGCARD; VAR lw: LONGWORD): BOOLEAN;
  85. BEGIN
  86.         IF NOT PipeOpen(p) THEN RETURN FALSE END;
  87.         pipe:=pipeptr(p);
  88.         IF (NOT (pipe^.cnt > 3)) THEN RETURN FALSE END;
  89.         b1:=ADR(lw);
  90.         FOR d:=0 TO 3 DO
  91.             b1^[d]:=withdraw(pipe);
  92.         END;
  93.         RETURN TRUE;
  94. END     PReadLongWord;
  95.  
  96. PROCEDURE      deposit(VAR tpipe: pipeptr; byte: BYTE);
  97. BEGIN
  98.         IF tpipe^.cnt < buflength THEN
  99.            INC(tpipe^.cnt);
  100.         ELSE
  101.            (* pipe full *)
  102.            RETURN;
  103.         END;
  104.         tpipe^.buf[tpipe^.bufhead]:=byte;
  105.         IF tpipe^.bufhead=bufend THEN
  106.            tpipe^.bufhead:=0;
  107.         ELSE
  108.            INC(tpipe^.bufhead);
  109.         END;
  110. END     deposit;
  111.  
  112. PROCEDURE      withdraw(VAR tpipe: pipeptr): BYTE;
  113. BEGIN
  114.         IF tpipe^.cnt > 0 THEN
  115.            DEC(tpipe^.cnt);
  116.         ELSE
  117.            (* pipe EMPTY *)
  118.            RETURN BYTE(0);
  119.         END;
  120.         IF tpipe^.buftail = bufend THEN
  121.            tpipe^.buftail:=0;
  122.         ELSE
  123.            INC(tpipe^.buftail);
  124.         END;
  125.         RETURN tpipe^.buf[tpipe^.buftail];
  126. END     withdraw;
  127.  
  128. PROCEDURE       OpenPipe(pipeName: ARRAY OF CHAR): LONGCARD;
  129. BEGIN
  130.         SysVar(sysvar);
  131.         pipespointer:=ADDRESS(sysvar.pipes);
  132.  
  133.         I:=0;   (* look for pipe name in system pipe list *)
  134.         found:=FALSE;
  135.         WHILE (I#32) AND (pipespointer^[I]#NIL) DO
  136.               newpipeptr:=pipespointer^[I];
  137.               INC(I);
  138.               IF Compare(pipeName,newpipeptr^.pipename)=Equal THEN
  139.                  I:=32;
  140.                  found:=TRUE;
  141.               END;
  142.         END;
  143.  
  144.         IF (NOT found) THEN
  145.            ALLOCATE(newpipeptr,LONGCARD(TSIZE(PIPE)));
  146.            Assign(newpipeptr^.pipename,pipeName);
  147.            newpipeptr^.bufhead:=0;
  148.            newpipeptr^.buftail:=bufend;
  149.            newpipeptr^.cnt:=0;
  150.            newpipeptr^.bufsize:=buflength;
  151.  
  152.            (* put address of pipe in system list *)
  153.            I:=0;
  154.            LOOP
  155.                 IF I=32 THEN HALT END;
  156.                 IF pipespointer^[I]=NIL THEN
  157.                    pipespointer^[I]:=newpipeptr;
  158.                    EXIT;
  159.                 END; 
  160.                 INC(I);
  161.            END;
  162.         END;
  163.         RETURN LONGCARD(newpipeptr);
  164. END     OpenPipe;
  165.  
  166. PROCEDURE       ClosePipe(p: LONGCARD);
  167. VAR             pipe          :     pipeptr;
  168. BEGIN
  169.            pipe:=pipeptr(p);
  170.            SysVar(sysvar);
  171.            pipespointer:=ADDRESS(sysvar.pipes);
  172.  
  173.            (* find address of pipe in system list *)
  174.            found:=FALSE;
  175.            I:=0;
  176.            LOOP
  177.                 IF I=32 THEN EXIT END;
  178.                 IF pipespointer^[I]=pipe THEN
  179.                    pipespointer^[I]:=NIL;
  180.                    found:=TRUE;
  181.                    EXIT;
  182.                 END; 
  183.                 INC(I);
  184.            END;
  185.  
  186.         IF found THEN
  187.            DEALLOCATE(pipe,LONGCARD(TSIZE(PIPE)));
  188.         END;
  189. END     ClosePipe;
  190.  
  191. PROCEDURE       PipeOpen(p: LONGCARD): BOOLEAN;
  192. VAR             pipe          :     pipeptr;
  193. BEGIN
  194.            pipe:=pipeptr(p);
  195.            SysVar(sysvar);
  196.            pipespointer:=ADDRESS(sysvar.pipes);
  197.  
  198.            (* find address of pipe in system list *)
  199.            I:=0;
  200.            LOOP
  201.                 IF I=32 THEN RETURN FALSE END;
  202.                 IF pipespointer^[I]=pipe THEN
  203.                    RETURN TRUE;
  204.                 END; 
  205.                 INC(I);
  206.            END;
  207. END     PipeOpen;
  208.  
  209. PROCEDURE       IsReadable(p: LONGCARD): BOOLEAN;
  210. BEGIN
  211.         pipe:=pipeptr(p);
  212.         IF pipe^.cnt > 0 THEN
  213.            RETURN TRUE;
  214.         ELSE
  215.            RETURN FALSE;
  216.         END;
  217. END     IsReadable;
  218.  
  219. PROCEDURE       IsWriteable(p: LONGCARD): BOOLEAN;
  220. BEGIN
  221.         pipe:=pipeptr(p);
  222.         IF pipe^.cnt < buflength THEN
  223.            RETURN TRUE;
  224.         ELSE
  225.            RETURN FALSE;
  226.         END;
  227. END     IsWriteable;
  228.  
  229. BEGIN
  230. END                   PIPE.
  231.